Business Assistant/Business Assistant.iso/indus/rental/tenant.prg

Text File | 1986-05-30 | 17KB | 540 lines

*    Last revision: May 26, 1986 at 11:43
* tenant.prg main command program of tenant database
STOR .t. TO first
* set up the loop
STOR .T. to more
DO WHIL more
* if first time this trip
 IF first
  DO t_first
  STOR .f. TO first
 ENDI
 STOR '<B>ackward, <D>elete/Recall, <E>dit, <F>orward, <H>elp, <P>rint' TO prompt1
 STOR '<S>earch by code number, search a<N>y part of database' TO prompt2
 STOR 'b<u>ilding records or <R>eturn to main Menu           SELECT: ' TO prompt3
 STOR 'Main Tenant Database ' TO mode
 STOR '?' TO command
* find out if the current record is marked for deletion
 IF DELETE()
  STOR 'Deleted' TO deleted
 ELSE
  STOR '       ' TO deleted
 ENDI *
 STOR trent TO trentx
 IF ttype = 'P'
  IF (trentpc*(trentpcr/100)/12)>trent
   STOR (trentpc*(trentpcr/100)/12) TO trentx
  ENDI (trentpc)
 ENDI ttype = 'P'
 IF ttype = 'O'
  STOR ((trentpc*(trentpcr/100)/12)+trent) TO trentx
 ENDI ttype = 'O'
 STOR (trentx + taddl + trente + trentm) TO trentxx
* show the current record, and find out what to do next
 @ 0, 0 SAY deleted
 @ 1,26 SAY mode
 @ 3,10 SAY tenant
 @ 3,62 SAY bcode
 @ 4,10 SAY tunit
 @ 4,36 SAY baddr
 @ 5,10 SAY tcontac
 @ 5,62 SAY tphone
 @ 6,36 SAY alt
 @ 7,10 SAY altad
 @ 8,10 SAY altcty
 @ 10,10 SAY ttype
 @ 10,36 SAY trentpc PICTURE '99.9999'
 @ 10,62 SAY tfirst
 @ 11,10 SAY trentpcr PICTURE '999,999,999'
 @ 11,62 SAY texpir
 @ 12,10 SAY tsec PICTURE '99,999.99'
 @ 12,36 SAY tsecb
 @ 12,62 SAY tlate
 @ 13,10 SAY trent PICTURE '99,999.99'
 @ 13,36 SAY tlatec PICTURE '99,999.99'
 @ 13,62 SAY taddl PICTURE '99,999.99'
 @ 14,10 SAY trente PICTURE '99,999.99'
 @ 14,36 SAY trentm PICTURE '99,999.99'
 @ 14,62 SAY trentxx PICTURE '99,999.99'
 @ 15,10 SAY trentd PICTURE '99,999.99'
 @ 15,36 SAY trentpd PICTURE '99/99/99'
 @ 15,62 SAY trentp PICTURE '99,999.99'
 @ 16,10 SAY trenty PICTURE '99,999.99'
 @ 16,36 SAY tflag
 @ 16,62 SAY trentt PICTURE '99,999.99'
 @ 18,10 SAY tnotes
 @ 18,61 SAY tupdate
 @ 20, 7 SAY prompt1
 @ 21, 7 SAY prompt2
 @ 22, 7 SAY prompt3
 @ 22,70 GET command PICTURE '!'
 READ
* perform selected function
 DO CASE
 CASE (command = 'B' .OR. command = ',' )
* move backwards one record
  SKIP -1
  LOOP
 CASE command = 'D'
* switch the current record from deleted to recalled
  IF DELETE()
   RECA
  ELSE
   DELE
  ENDI DELETE()
  LOOP
 CASE command = 'E'
  SET DELIMITER OFF
  SET INTENSITY ON
* store field variables into mem variables for editing
  STOR tenant TO mtenant
  STOR bcode TO mbcode
  STOR tunit TO mtunit
  STOR baddr TO mbaddr
  STOR tcontac TO mtcontac
  STOR tphone TO mtphone
  STOR alt TO malt
  STOR altad TO maltad
  STOR altcty TO maltcty
  STOR ttype TO mttype
  STOR trentpc TO mtrentpc
  STOR texpir TO mtexpir
  STOR trentpcr TO mtrenpcr
  STOR tfirst TO mtfirst
  STOR tsec TO mtsec
  STOR tsecb TO mtsecb
  STOR tlate TO mtlate
  STOR trent TO mtrent
  STOR taddl TO mtaddl
  STOR trente TO mtrente
  STOR trentm TO mtrentm
  STOR trentp TO mtrentp
  STOR trentpd TO mtrentpd
  STOR tlatec TO mtlatec
  STOR trentd TO mtrentd
  STOR trenty TO mtrenty
  STOR trentt TO mtrentt
  STOR tflag TO mtflag
  STOR tnotes TO mtnotes
  STOR tupdate TO mtupdate
* set up screen and prompt for editing
  STOR 'Edit Tenant Data          ' TO mode
  STOR '                 Enter the new or corrected information        ' TO prompt1
  STOR "                 Control 'Q'or 'W' to end edit session   " TO prompt2
  STOR SPACE(70) TO prompt3
  @ 1,26 SAY mode
  @ 3,10 GET mtenant
  @ 3,62 GET mbcode PICTURE '99999'
  @ 4,10 GET mtunit
  @ 4,36 GET mbaddr
  @ 5,10 GET mtcontac
  @ 5,62 GET mtphone PICTURE '[phone]'
  @ 6,36 GET malt PICTURE '!'
  @ 7,10 GET maltad
  @ 8,10 GET maltcty
  @ 10,10 GET mttype PICTURE '!'
  @ 10,36 GET mtrentpc
  @ 10,62 GET mtfirst PICTURE '99/99/99'
  @ 11,10 SAY SPACE(16)
  @ 11,10 GET mtrenpcr
  @ 11,62 GET mtexpir PICTURE '99/99/99'
  @ 12,10 GET mtsec
  @ 12,36 GET mtsecb
  @ 12,62 GET mtlate PICTURE '99'
  @ 13,10 GET mtrent
  @ 13,36 GET mtlatec
  @ 13,62 GET mtaddl
  @ 14,10 GET mtrente
  @ 14,36 GET mtrentm
  @ 15,10 GET mtrentd
  @ 15,36 GET mtrentpd PICTURE '99/99/99'
  @ 15,62 GET mtrentp
  @ 16,10 GET mtrenty
  @ 16,36 GET mtflag PICTURE '99/99/99'
  @ 16,62 GET mtrentt
  @ 18,10 GET mtnotes
  @ 18,61 GET mtupdate PICTURE '99/99/99'
  @ 20,07 SAY prompt1
  @ 21,07 SAY prompt2
  @ 22,07 SAY prompt3
  READ
  CLEA GETS
* test if there is a bad field validation
  DO CASE
  CASE mbcode = ' '
   STOR .t. TO error
  CASE .NOT.(malt = 'Y' .OR. malt = 'N')
   STOR .t. TO error
  CASE .NOT.(mttype = 'R'.OR.mttype='P'.OR. mttype='O')
   STOR .t. TO error
  CASE (mttype = 'P'.OR. mttype = 'O') .AND.(.NOT.(mtrentpc >0.AND. mtrenpcr >0))
   STOR .t. TO error
  OTHE
   STOR .f. TO error
  ENDC
* if test for error was true then fix the fields that need fixing
  IF error
* erase the lines to be used for prompts
   @ 01,00
   @ 20,00
   @ 21,00
   @ 22,00
* tell them to correct it
   @ 1,18 SAY 'Please Correct the Indicated Data'
* keep looping until all fields are fixed
   STOR .t. to an_error
   DO WHIL an_error
    DO CASE
    CASE mbcode = ' '
     @ 20,01 SAY SPACE(75)
     @ 21,01 SAY SPACE(75)
     @ 20,15 SAY 'Must have a tenant code       '
     @ 03,62 GET mbcode PICTURE '99999'
     READ
    CASE .NOT.(malt = 'Y' .OR. malt = 'N')
     @ 20,01 SAY SPACE(75)
     @ 21,01 SAY SPACE(75)
     @ 20,15 SAY "Must answer 'Y' or 'N' to alternate address"
     @ 06,36 GET malt PICTURE '!'
     READ
    CASE .NOT.(mttype = 'R'.OR.mttype='P'.OR. mttype='O')
     @ 20,01 SAY SPACE(75)
     @ 21,01 SAY SPACE(75)
     @ 20,05 SAY "Type must be 'R' for Regular, 'P' for Percentage which uses the higher of"
     @ 21,05 SAY "the percentage or the base rent or 'O' for Overage plus base rent"
     @ 10,10 GET mttype PICTURE '!'
     READ
    CASE (mttype = 'P'.OR. mttype = 'O').AND.(.NOT.(mtrentpc>0.AND. mtrenpcr> 0))
     @ 20,01 SAY SPACE(75)
     @ 21,01 SAY SPACE(75)
     @ 20,05 SAY 'If a percentage or overage lease, you must state the percentage'
     @ 21,05 SAY 'AND the base for calculating the percentage rent'
     @ 10,36 GET mtrentpc
     @ 11,10 GET mtrenpcr
     READ
    OTHE
     STOR .f. TO an_error
    ENDC
   ENDD while an:error
  ENDI error
  STOR 'N' TO command
  SET DELIMITER ON
  SET INTENSITY OFF
  @ 20,01 SAY SPACE(75)
  @ 21,01 SAY SPACE(75)
  @ 20,23 SAY 'Are there any more changes ?   '
  @ 20,50 GET command picture '!'
  READ
  SET INTENSITY ON
  SET DELIMITER OFF
  IF command = 'Y'
   @ 1,00
   @ 1,26 SAY mode
   @ 3,10 GET mtenant
   @ 3,62 GET mbcode PICTURE '99999'
   @ 4,10 GET mtunit
   @ 4,36 GET mbaddr
   @ 5,10 GET mtcontac
   @ 5,62 GET mtphone PICTURE '[phone]'
   @ 6,36 GET malt PICTURE '!'
   @ 7,10 GET maltad
   @ 8,10 GET maltcty
   @ 10,10 GET mttype PICTURE '!'
   @ 10,36 GET mtrentpc
   @ 10,62 GET mtfirst PICTURE '99/99/99'
   @ 11,10 GET mtrenpcr
   @ 11,62 GET mtexpir PICTURE '99/99/99'
   @ 12,10 GET mtsec
   @ 12,36 GET mtsecb
   @ 12,62 GET mtlate PICTURE '99'
   @ 13,10 GET mtrent
   @ 13,36 GET mtlatec
   @ 13,62 GET mtaddl
   @ 14,10 GET mtrente
   @ 14,36 GET mtrentm
   @ 15,10 GET mtrentd
   @ 15,36 GET mtrentpd PICTURE '99/99/99'
   @ 15,62 GET mtrentp
   @ 16,10 GET mtrenty
   @ 16,36 GET mtflag PICTURE '99/99/99'
   @ 16,62 GET mtrentt
   @ 18,10 GET mtnotes
   @ 18,61 GET mtupdate PICTURE '99/99/99'
   @ 20,01 SAY SPACE(75)
   @ 21,01 SAY SPACE(75)
   @ 22,01 SAY SPACE(75)
   @ 20,07 SAY prompt1
   @ 21,07 SAY prompt2
   @ 22,07 SAY prompt3
* let user enter data
   READ
   CLEA GETS
  ENDI command = 'Y'
  REPL tenant WITH mtenant, bcode WITH mbcode, tunit WITH mtunit
  REPL baddr WITH mbaddr, tcontac WITH mtcontac, tphone WITH mtphone
  REPL alt WITH malt, altad WITH maltad, altcty WITH maltcty
  REPL ttype WITH mttype, texpir WITH mtexpir
  REPL trentpc WITH mtrentpc, trentpcr WITH mtrenpcr
  REPL tfirst WITH mtfirst, tsec WITH mtsec, tsecb WITH mtsecb
  REPL t